home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / geo.bas < prev    next >
BASIC Source File  |  1984-05-25  |  13KB  |  313 lines
  1. 5 ' can be compiled for better performance
  2. 6 '
  3. 10 ' **************************************************************************
  4. 15 ' *                              GEO                                       *
  5. 20 ' *                    Phil Grier - Laurel MD                              *
  6. 25 ' *                        (301) 498-2226                                  *
  7. 30 ' *                              9-83                                      *
  8. 35 ' **************************************************************************
  9. 40 '
  10. 45 ' (C) COPYRIGHT 1983, PHIL GRIER, LAUREL, MARYLAND
  11. 50 '
  12. 55 ' Permission to copy without fee all or part of this program is granted
  13. 60 ' provided that the copies are not made or distributed for commercial
  14. 65 ' advantage, the copyright notice appears, and notice is given that
  15. 70 ' copying is by permission.
  16. 75 '
  17. 80 ' **************************************************************************
  18. 85 '
  19. 100 CLEAR
  20. 110 OPTION BASE 1
  21. 120 DIM X$(500),FOUND$(500) ' REMEMBER TO CHANGE LINE # 360 ALSO.
  22. 130 SCREEN 0,0,0,0
  23. 140 COLOR 7,0,0
  24. 150 WIDTH 80
  25. 160 CLS
  26. 170 SP$=STRING$(15," ")
  27. 180 KEY OFF
  28. 190 RANDOMIZE (VAL(RIGHT$(TIME$,2))*555)
  29. 200 GOTO 280
  30. 210 LOCATE 25,60
  31. 220 PRINT"PRESS ";
  32. 230 COLOR 18
  33. 240 PRINT"<ENTER>";
  34. 250 COLOR 7
  35. 260 PHIL$=INKEY$
  36. 270 IF PHIL$="" THEN 260 ELSE RETURN
  37. 280 '***********************  G E O G R A P H Y  *******************************
  38. 290 ' the aprostophy (') and REM mean the same thing - remark.
  39. 300 DEFINT A-Z
  40. 310 CLS
  41. 320 KEY OFF
  42. 330 GOSUB 1670
  43. 340 ON ERROR GOTO 2880
  44. 350 '
  45. 360 FINIS=500
  46. 370 FOR I=1 TO FINIS
  47. 380 READ X$(I)
  48. 390 NEXT I
  49. 400 FINIS=I
  50. 410 PRINT
  51. 420 PRINT"I know of"FINIS"locations.";
  52. 430 PRINT"  Press ";
  53. 440 COLOR 18
  54. 450 PRINT"<ENTER>";
  55. 460 COLOR 7
  56. 470 PRINT"."
  57. 480 IN$=INKEY$
  58. 490 IF IN$<>CHR$(13) THEN 480
  59. 500 CLS
  60. 510 BEEP
  61. 520 INPUT "Make your initial selection: ",IN$
  62. 530 IF IN$="" THEN LOCATE CSRLIN-1:GOTO 510
  63. 540 IF ASC(LEFT$(IN$,1))>90 THEN PRINT"Enter in upper case only.  Press the <CAPS LOCK> button once.":PRINT,"(to the right of the spacebar)":GOSUB 210:CLS:GOTO 510
  64. 550 FOR I=1 TO FINIS
  65. 560 IF IN$=X$(I) THEN PRINT TAB(30):LOCATE CSRLIN-1:PRINT "-Ok, good.  "IN$" is a match.":GOSUB 1260:GOTO 1010
  66. 570 NEXT I
  67. 580 PRINT IN$" is not in my vocabulary."
  68. 590 GOSUB 2070
  69. 600 GOTO 510
  70. 610 '
  71. 620 '
  72. 630 '********************** players selection *********************************
  73. 640 USED=0
  74. 650 GOSUB 1480
  75. 660 BEEP
  76. 670 INPUT "You Select: ",IN$
  77. 680 GOSUB 1480
  78. 690 IF IN$="CHALLENGE" OR IN$="CHALLANGE" THEN 1370
  79. 700 IF IN$="QUIT" OR IN$="END" THEN 1950
  80. 710 IF IN$="STOP" THEN PRINT"You entered STOP.  To resume, press 'R'.  Any other key will end this game." ELSE 750
  81. 720 PHIL$=INKEY$
  82. 730 IF PHIL$="" THEN 720
  83. 740 IF PHIL$="R" THEN 610 ELSE 1950
  84. 750 IF LEN(IN$)<2 THEN LOCATE CSRLIN-1:GOTO 610
  85. 760 IF ASC(LEFT$(IN$,1))>90 THEN PRINT"Enter in upper case only.  Press the <CAPS LOCK> button once.":GOSUB 2070:GOTO 610
  86. 770 IF IN$="" THEN LOCATE CSRLIN-1:GOTO 610
  87. 780 PRINT TAB(LEN(IN$)+14);
  88. 790 LOCATE CSRLIN-1
  89. 800 COLOR 18
  90. 810 PRINT"searching";
  91. 820 COLOR 7
  92. 830 PRINT
  93. 840 IF LEFT$(IN$,1)<>RIGHT$(FOUND$(FOUND),1) THEN PRINT TAB(14+LEN(IN$));:LOCATE CSRLIN-1:PRINT"*";:COLOR 18:PRINT"*";:COLOR 7:PRINT"* Your first letter doesn't match my last one.":GOSUB 2070:GOTO 610
  94. 850 GOSUB 1180
  95. 860 IF USED=1 THEN 610
  96. 870 I=1
  97. 880 WHILE I<FINIS
  98. 890 IF IN$=X$(I) THEN GOSUB 1000:GOSUB 1260:GOTO 1010
  99. 900 I=I+1
  100. 910 WEND
  101. 920 LOCATE CSRLIN-1,14+LEN(IN$)
  102. 930 PRINT"*";
  103. 940 COLOR 18
  104. 950 PRINT"*";
  105. 960 COLOR 7
  106. 970 PRINT"* "IN$" not found"
  107. 980 GOSUB 2070
  108. 990 GOTO 610
  109. 1000 IF IN$=X$(I) THEN PRINT TAB(13):LOCATE CSRLIN-1:SOUND 1200,2:COLOR 0,7:PRINT" ";IN$;" ";:COLOR 7,0:PRINT" IS A MATCH.":RETURN '***inform user that input value was valid
  110. 1010 '
  111. 1020 '
  112. 1030 '********************* computers selection ********************************
  113. 1040 START=RND(1)*(FINIS-1)
  114. 1050 FOR I=START TO FINIS
  115. 1060 IF LEFT$(X$(I),1)=RIGHT$(IN$,1) THEN GOSUB 1260:GOTO 1160
  116. 1070 NEXT I
  117. 1080 FOR I=START TO 1 STEP -1
  118. 1090 IF LEFT$(X$(I),1)=RIGHT$(IN$,1) THEN GOSUB 1260:GOTO 1160
  119. 1100 NEXT I
  120. 1110 PRINT
  121. 1120 PRINT"*** I can't find any more locations starting with ";RIGHT$(FOUND$(FOUND),1);"."
  122. 1130 PRINT
  123. 1140 PRINT"You did a good job.  You win........this time."
  124. 1150 GOTO 1950
  125. 1160 PRINT"I selected: "FOUND$(FOUND)
  126. 1170 GOTO 610
  127. 1180 '
  128. 1190 '
  129. 1200 '********************  Locate in found list  ******************************
  130. 1210 USED=0
  131. 1220 FOR J=1 TO FOUND
  132. 1230 IF IN$=FOUND$(J) THEN PRINT TAB(14+LEN(IN$));:LOCATE CSRLIN-1:PRINT"*";:COLOR 18:PRINT"*";:COLOR 7:PRINT"* Is already used!":GOSUB 2070:USED=1:GOTO 1250
  133. 1240 NEXT J
  134. 1250 RETURN
  135. 1260 '
  136. 1270 '
  137. 1280 '******** decrement the supply list & increment the FOUND list by one *****
  138. 1290 FOUND=FOUND+1
  139. 1300 FOUND$(FOUND)=X$(I)
  140. 1310 FOR J=I TO FINIS-1
  141. 1320 X$(J)=X$(J+1)
  142. 1330 NEXT J
  143. 1340 FINIS=FINIS-1
  144. 1350 GOSUB 1500
  145. 1360 RETURN
  146. 1370 '
  147. 1380 '
  148. 1390 '************************* Challenge routine ******************************
  149. 1400 J=1
  150. 1410 WHILE J<FINIS
  151. 1420 IF LEFT$(X$(J),1)=RIGHT$(FOUND$(FOUND),1) THEN PRINT:COLOR 0,7:PRINT " ";X$(J);" ";:COLOR 7,0:PRINT" remained to be selected!  You lose!":GOSUB 2070:GOTO 1470
  152. 1430 J=J+1
  153. 1440 WEND
  154. 1450 PRINT
  155. 1460 PRINT"You won!  I can't find another selection to match you."
  156. 1470 GOTO 1950
  157. 1480 '
  158. 1490 '
  159. 1500 '**********************  print points  ***********************************
  160. 1510 THISROW=CSRLIN
  161. 1520 THISCOL=POS(0)
  162. 1530 LOCATE 1,65
  163. 1540 COLOR 0,7
  164. 1550 PRINT SP$
  165. 1560 LOCATE 1,65
  166. 1570 PRINT FOUND"SELECTED  ";
  167. 1580 COLOR 7,0
  168. 1590 LOCATE 2,65
  169. 1600 COLOR 0,7
  170. 1610 PRINT SP$
  171. 1620 LOCATE 2,65
  172. 1630 PRINT FINIS"REMAINING";
  173. 1640 COLOR 7,0
  174. 1650 LOCATE THISROW,THISCOL
  175. 1660 RETURN
  176. 1670 '
  177. 1680 '
  178. 1690 '**********************  Heading instructions  ****************************
  179. 1700 CLS
  180. 1710 LOCATE 2,30
  181. 1720 COLOR 0,7
  182. 1730 PRINT" G E O G R A P H Y ";
  183. 1740 COLOR 7,0
  184. 1750 PRINT
  185. 1760 LOCATE 5,1,0
  186. 1770 PRINT"The object of this game is to name:"
  187. 1780 PRINT
  188. 1790 PRINT,"1) A CONTINENT"
  189. 1800 PRINT,"2) A COUNTRY"
  190. 1810 PRINT,"3) A COUNTRY'S CAPITOL CITY"
  191. 1820 PRINT,"4) A STATE"
  192. 1830 PRINT,"5) A STATE CAPITOL"
  193. 1840 PRINT,"6) AN OCEAN OR SEA"
  194. 1850 PRINT
  195. 1860 PRINT"Enter your selection with your word's first character matching the last"
  196. 1870 PRINT"character of my last selected word, and I'll select mine likewise."
  197. 1880 PRINT
  198. 1890 PRINT"If you suspect no more names can be matched, enter CHALLENGE.  If I find"
  199. 1900 PRINT"a match, I'll tell you what you missed, and you lose.  If I can't find a"
  200. 1910 PRINT"match for your word, then you win."
  201. 1920 PRINT
  202. 1930 PRINT"example: marylan(D) -> (D)enve(R) -> (R)ussi(A) -> (A)tlantic ocea(N), etc."
  203. 1940 RETURN
  204. 1950 '
  205. 1960 '
  206. 1970 '***********************  exit routine  ***********************************
  207. 1980 PRINT
  208. 1990 PRINT
  209. 2000 PRINT"You made"INT(FOUND/2)"responses, and there are"FINIS"names you haven't used."
  210. 2010 PRINT
  211. 2020 PRINT"Play again?  (Y or N)";
  212. 2030 PHIL$=INKEY$
  213. 2040 IF PHIL$="" THEN 2030
  214. 2050 IF PHIL$="Y" THEN 100
  215. 2060 GOTO 2950
  216. 2070 '
  217. 2080 '
  218. 2090 '*********************** BRAAP ERROR SOUND *****************************
  219. 2100 SOUND 40,15
  220. 2110 RETURN
  221. 2120 '
  222. 2130 '
  223. 2140 '***********************  States  ****************************************
  224. 2150 DATA ALABAMA,ARKANSAS,ALASKA,ARIZONA,CALIFORNIA,MAINE,NEW HAMPSHIRE
  225. 2160 DATA VERMONT,MASSACHUSETTS,CONNECTICUT,RHODE ISLAND,NEW YORK
  226. 2170 DATA NEW JERSEY,PENNSYLVANIA,DELAWARE,MARYLAND,VIRGINIA,WEST VIRGINIA
  227. 2180 DATA NORTH CAROLINA,SOUTH CAROLINA,GEORGIA,FLORIDA,MISSISSIPPI
  228. 2190 DATA LOUISIANA,TEXAS,NEW MEXICO,OREGON,WASHINGTON,IDAHO,NEVADA
  229. 2200 DATA MONTANA,UTAH,COLORADO,KANSAS,MISSOURI,NORTH DAKOTA,MINNESOTA
  230. 2210 DATA SOUTH DAKOTA,ILLINOIS,OHIO,KENTUCKY,TENNESSEE,IOWA,HAWAII
  231. 2220 DATA WISCONSIN,MICHIGAN,NEBRASKA,INDIANA,OKLAHOMA,WYOMING
  232. 2230 DATA WASHINGTON D.C.,UNITED STATES
  233. 2240 '
  234. 2250 '
  235. 2260 '*********************  State Capitols  **********************************
  236. 2270 DATA MONTGOMERY,JUNEAU,PHOENIX,LITTLE ROCK,SACRAMENTO,DENVER
  237. 2280 DATA HARTFORD,DOVER,TALLAHASSEE,ATLANTA,HONOLULU,BOISE,SPRINGFIELD
  238. 2290 DATA DES MOINES,TOPEKA,FRANKFORT,BATON ROUGE,AUGUSTA,ANNAPOLIS
  239. 2300 DATA BOSTON,LANSING,ST. PAUL,JACKSON,JEFFERSON CITY,HELENA
  240. 2310 DATA LINCOLN,CARSON CITY,CONCORD,TRENTON,SANTE FE,ALBANY,INDIANAPOLIS
  241. 2320 DATA RALEIGH,BISMARK,COLUMBUS,OKLAHOMA CITY,SALEM,HARRISBURG
  242. 2330 DATA PROVIDENCE,COLUMBIA,PIERRE,NASHVILLE,AUSTIN,SALT LAKE CITY
  243. 2340 DATA MONTPELIER,RICHMOND,OLYMPIA,CHARLESTON,MADISON,CHEYANNE
  244. 2350 '
  245. 2360 '
  246. 2370 '********************  Canada  *******************************************
  247. 2380 DATA ALBERTA,BRITISH COLUMBIA,MANITOBA,NEW BRUNSWICK,NEWFOUNDLAND
  248. 2390 DATA NORTHWEST TERRITORIES,NOVA SCOTIA,ONTARIO,QUEBEC,CANADA
  249. 2400 DATA PRINCE EDWARD ISLAND,SASKATCHEWAN,YUKON TERRITORY,CANADA
  250. 2410 DATA OTTOWA,HALIFAX,MONTREAL,VANCOUVER,VICTORIA
  251. 2420 '
  252. 2430 '
  253. 2440 '****************** Western Hemisphere ***********************************
  254. 2450 DATA UNITED STATES,MEXICO,EL SALVADOR,SAN SALVADOR,GUATAMALA
  255. 2460 DATA NICARAGUA,PANAMA,COLUMBIA,PERU,BOLIVIA,BRAZIL,ARGENTINA
  256. 2470 DATA CUBA,COSTA RICA,HONDURAS,VENESUALA,URUGUAY,PARAGUAY,LA PAS
  257. 2480 DATA MEXICO CITY,BRAZILIA,CHILE,SANTIAGO,CARRACUS,NEW GUINEA
  258. 2490 DATA ANTIGUA,EQUADOR,GHANA,BUENOS AIRES
  259. 2500 '
  260. 2510 '
  261. 2520 '************************  Countries  ************************************
  262. 2530 DATA EUROPE,ASIA,ENGLAND,WALES,IRELAND,SCOTLAND,FINLAND,NORWAY,SWEDEN
  263. 2540 DATA LUXEMBOURG,FRANCE,GERMANY,BELGIUM,SWITZERLAND,ITALY,SPAIN,MALTA
  264. 2550 DATA PORTUGAL,HUNGARY,CZECHOSLOVAKIA,ALBANIA,TIBET,INDIA,LITHUANIA
  265. 2560 DATA AUSTRALIA,SOUTH AMERICA,NORTH AMERICA,AFRICA,MOSAMBIQUE,YEMEN
  266. 2570 DATA POLAND,RUSSIA,CHINA,JAPAN,BURMA,INDONESIA,HOLLAND,NEW ZEALAND
  267. 2580 DATA SOUTH AFRICA,ZAMBIA,KENYA,ISRAEL,PALESTINE,IRAN,VIET NAM,SIAM
  268. 2590 DATA GREECE,CENTRAL AMERICA,LEBANON,PAKISTAN,SYRIA,FORMOSA,EGYPT,DENMARK
  269. 2600 DATA YALTA,SINGAPORE,ROMANIA,JAVA,AUSTRIA,TANZANIA,AMSTERDAM,AZORES
  270. 2610 DATA KOREA,CAMBODIA,THAILAND,CAMPOCHIA,TOKYO,MOSCOW,PEKING,LOAS,MALAYSIA
  271. 2620 DATA WARSAW,LONDON,NORTHERN IRELAND,BELFAST,OSLO,PARIS,EAST GERMANY
  272. 2630 DATA BRUSSELS,ZURICH,ROME,SYDNEY,MADRID,NEPAL,NETHERLANDS,ATHENS,CHAD
  273. 2640 DATA ANTARCTICA,TURKEY,ARMENIA,AFGHANASTAN,TIWAN,ETHIOPIA,MADAGASGAR
  274. 2650 DATA NORTH KOREA,SOUTH KOREA,RHODESIA,KUWAIT,YUGOSLAVIA,ANGLOA,DAKAR
  275. 2660 DATA SAUDI ARABIA,SAMOA,SUDAN,LIBYA,ARABIA,JORDAN,BEIRUT,JERUSALEM
  276. 2670 DATA RANGOON,TRIPOLI,ALGERIA,ANDORRA,ANGOLIA,BARBADOS,BANGLADESH,CYPRUS
  277. 2680 DATA BAHRAIN,BHUTAN,BOTSWANA,BULGARIA,BURUNDI,CAMEROON,CEYLON,CONGO
  278. 2690 DATA DAHOMEY,DOMINICAN REPUBLIC,ECUADOR,FIJI,GABON,GAMBIA,HAITI,ICELAND
  279. 2700 DATA IVORY COAST,IRAQ,JAMACA,LAOS,LIBERIA,MALAWI,MALAYA,MALI,MONGOLIA
  280. 2710 DATA MOZAMBIQUE,NIGER,NIGERIA,OMAN,PHILIPPINES,QUATAR,RWANDA,SOMALIA
  281. 2720 DATA SENEGAL,SIERRA LEONE,SWAZILAND,TOGO,TUNISIA,TRINIDAD,ZAYRE
  282. 2730 DATA USSR,UPPER VOLTA,SHANGHAI,CALCUTTA,SAO PAULO,BOMBAY,DJAKARTA
  283. 2740 DATA SEOUL,RIO DE JANERIO,CAIRO,HONG KONG,BERLIN,MANILA,NEW DELHI
  284. 2750 DATA KARACHI,MILAN,LIMA,BARCELONA,BUDAPEST,BANKOK,JOHANNESBURG,ANGOLA
  285. 2760 DATA ISTANBUL,VIENNA,HAVANA,GLASGOW,LISBON,COPENHAGEN,STOCKHOLM
  286. 2770 DATA PRAGUE,YOKOHAMA,MOROCCO,SOMALI,DAKARTA,NAIROBI,UGANDA,MADAGASCAR
  287. 2780 '
  288. 2790 '******************** Oceans & Seas **************************************
  289. 2800 DATA ATLANTIC OCEAN,PACIFIC OCEAN,INDIAN OCEAN,ASIATIC SEA,CASPEAN SEA
  290. 2810 DATA YELLOW SEA,BALTIC SEA,RED SEA,DEAD SEA,BLACK SEA,AEGEAN SEA
  291. 2820 DATA SOUTH CHINA SEA,CHINA SEA,MEDITERRANEAN SEA,ARCTIC OCEAN
  292. 2830 DATA ADRIATIC SEA,BERING SEA,NORTH SEA,CARIBBEAN SEA,SEA OF JAPAN
  293. 2840 DATA BEAUFORT SEA,CHUKCHI SEA,EAST SIBERIAN SEA,LAPTEV SEA,KARA SEA
  294. 2850 DATA BARENTS SEA,NORWEGIAN SEA,GREENLAND SEA,LINCOLN SEA,LABRADOR SEA
  295. 2860 DATA WHITE SEA,BALEARIC SEA,ALBORAN SEA,LIGURIAN SEA,TYRRHENIAN SEA
  296. 2870 DATA IONIAN SEA,SEA OF CRETE,SEA OF MARMARA,SEA OF AZOV,ARABIAN SEA
  297. 2871 DATA WEDDELL SEA,SCOTIA SEA,BELLINGSHAUSEN SEA,AMUNDSEN SEA,ROSS SEA
  298. 2872 DATA SEA OF OKHOTSK,CORAL SEA,TASMAN SEA,ARAFURA SEA,BANDA SEA
  299. 2873 DATA FLORES SEA,CELEBES SEA,JAVA SEA,SULU SEA,EAST CHINA SEA
  300. 2880 '
  301. 2890 '
  302. 2900 '**********  Error handler for read end of array  ************************
  303. 2910 IF ERR=4 THEN RESUME 400 '** error code received if out of data statements
  304. 2920 IF ERR<>0 THEN PRINT "THE ERROR IS #"ERR"IN LINE"ERL'***** if error wasn't handled by above line
  305. 2930 PRINT
  306. 2940 GOSUB 210
  307. 2950 CLS
  308. 2960 END
  309. T "THE ERROR IS #"ERR"IN LINE"ERL'***** if error wasn't handled by above line
  310. 2930 PRINT
  311. 2940 GOSUB 210
  312. 2950 CLS
  313. 2960 END